home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Workbench Add-On
/
Workbench Add-On - Volume 1.iso
/
Dev
/
Oberon
/
source
/
AmigaUtil
/
ExecUtil.mod
< prev
next >
Wrap
Text File
|
1995-06-29
|
4KB
|
144 lines
(***************************************************************************
$RCSfile: ExecUtil.mod $
Description: Support for clients of exec.library
Created by: fjc (Frank Copeland)
$Revision: 3.9 $
$Author: fjc $
$Date: 1995/06/04 23:18:08 $
Copyright © 1994, Frank Copeland.
This file is part of the Oberon-A Library.
See Oberon-A.doc for conditions of use and distribution.
***************************************************************************)
<* STANDARD- *>
MODULE ExecUtil;
IMPORT SYS := SYSTEM, e := Exec;
TYPE
CompareProc * = PROCEDURE ( n1, n2 : e.CommonNodePtr ) : INTEGER;
(*--------------------------------------------------------------------*)
(*
Exec List handling procedures
*)
(*------------------------------------*)
PROCEDURE GetSucc * ( node : e.CommonNodePtr ) : e.CommonNodePtr;
VAR mn : e.MinNodePtr;
BEGIN (* GetSucc *)
mn := SYS.VAL (e.MinNodePtr, node);
IF mn # NIL THEN
mn := mn.succ; IF mn.succ = NIL THEN mn := NIL END
END;
RETURN mn
END GetSucc;
(*------------------------------------*)
PROCEDURE GetPred * ( node : e.CommonNodePtr ) : e.CommonNodePtr;
VAR mn : e.MinNodePtr;
BEGIN (* GetPred *)
mn := SYS.VAL (e.MinNodePtr, node);
IF mn # NIL THEN
mn := mn.pred; IF mn.pred = NIL THEN mn := NIL END
END;
RETURN mn
END GetPred;
(*------------------------------------*)
PROCEDURE GetHead * ( VAR list : e.CommonList ) : e.CommonNodePtr;
VAR ml : e.MinListPtr; mn : e.MinNodePtr;
BEGIN (* GetHead *)
ml := SYS.ADR (list);
mn := ml.head; IF mn.succ = NIL THEN mn := NIL END;
RETURN mn
END GetHead;
(*------------------------------------*)
PROCEDURE GetTail * ( VAR list : e.CommonList ) : e.CommonNodePtr;
VAR ml : e.MinListPtr; mn : e.MinNodePtr;
BEGIN (* GetTail *)
ml := SYS.ADR (list);
mn := ml.tailPred; IF mn.pred = NIL THEN mn := NIL END;
RETURN mn
END GetTail;
(*------------------------------------*)
PROCEDURE ListLength * ( VAR list : e.CommonList ) : LONGINT;
VAR ml : e.MinListPtr; mn : e.MinNodePtr; count : LONGINT;
BEGIN (* ListLength *)
count := 0; ml := SYS.ADR (list); mn := ml.head;
WHILE mn.succ # NIL DO INC (count); mn := mn.succ END;
RETURN count;
END ListLength;
(*------------------------------------*)
PROCEDURE NodeAt * ( VAR list : e.CommonList; pos : LONGINT )
: e.CommonNodePtr;
VAR ml : e.MinListPtr; mn : e.MinNodePtr; count : LONGINT;
BEGIN (* NodeAt *)
count := pos; ml := SYS.ADR (list); mn := ml.head;
IF mn # NIL THEN
WHILE (mn.succ # NIL) & (count > 0) DO
DEC( count ); mn := mn.succ;
END;
IF mn.succ = NIL THEN mn := NIL END
END;
RETURN mn
END NodeAt;
(*------------------------------------*)
PROCEDURE InsertAt *
( VAR list : e.CommonList; node : e.CommonNodePtr; pos : LONGINT );
VAR mn : e.MinNodePtr;
BEGIN (* InsertAt *)
mn := SYS.VAL (e.MinNodePtr, NodeAt (list, pos));
IF mn = NIL THEN e.AddTail (list, node)
ELSE e.Insert (list, node, mn.pred)
END
END InsertAt;
(*------------------------------------*)
PROCEDURE InsertOrdered *
( VAR list : e.CommonList; node : e.CommonNodePtr; Compare : CompareProc )
: LONGINT;
VAR pn, nn : e.MinNodePtr; position : LONGINT;
BEGIN (* InsertOrdered *)
position := 0; pn := NIL; nn := SYS.VAL (e.MinNodePtr, GetHead (list));
WHILE (nn # NIL) & (Compare (node, nn) >= 0) DO
pn := nn; nn := SYS.VAL (e.MinNodePtr, GetSucc (nn));
INC (position)
END;
e.Insert (list, node, pn);
RETURN position;
END InsertOrdered;
(*------------------------------------*)
PROCEDURE RemoveAt * ( VAR list : e.CommonList; pos : LONGINT )
: e.CommonNodePtr;
VAR node : e.CommonNodePtr;
BEGIN (* RemoveAt *)
node := NodeAt( list, pos );
IF node # NIL THEN e.Remove (node) END;
RETURN node;
END RemoveAt;
END ExecUtil.